home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / 16edit / 16edit4.bas < prev    next >
BASIC Source File  |  1993-07-08  |  25KB  |  394 lines
  1. 10 ' １６色グラフィックツール Ｖｅｒ　４．２４ 元内康博
  2. 20 '　 制作期間  ９１年９月　～　９２年６月５日   ９２年１１月０４日
  3. 30 CLEAR ,,,400000:DEFINT A-Z:SCREEN@0:COLOR 7,0,0,0:CLS 4
  4. 40 DIM PIC全(76800),PL(2,15),PIC1(64),PIC絵(76800),SE$(18),PIC2(640),PIC3(1024)
  5. 50 GET@A(0,0)-(639,479),PIC全:MOUSE 0:MOUSE 1,320,240,1:MOUSE 4,0,0,640,480
  6. 60 FOR A=0 TO 18:READ SE$(A):NEXT:CO=15:速度=8
  7. 70 FOR A=0 TO 15:FOR B=0 TO 2:READ PL(B,A):NEXT:PALETTE A,[PL(0,A),PL(1,A),PL(2,A)]:NEXT:GOTO *MAIN
  8. 80 DATA 画面消去,16*16拡大,32*32拡大,ﾊﾟﾚｯﾄ変更,絵のＳＡＶＥorＬＯＡＤ,絵のﾊﾟﾚｯﾄのSAVEorLOAD,ＣＤＰＬＡＥＲ,塗り潰し,絵の複写,プログラムＳＴＯＰ
  9. 90 DATA 絵の拡大,絵の反転,64*64拡大,アニメーション,圧縮   Ｖｅｒ１.０２,展開   Ｖｅｒ１.０２,色入替え,線を描く,マウスの速度の変更
  10. 100 DATA 0,0,0,0,0,128,0,128,0,0,128,128,128,0,0,128,0,128,128,128,0,128,128,128,64,64,64,0,0,255,0,255,0,0,255,255,255,0,0,255,0,255,255,255,0,255,255,255
  11. 110 *PICIN:GET@A(0,0)-(639,479),PIC全:RETURN
  12. 120 *PICOUT:PUT@A(0,0)-(639,479),PIC全:CONSOLE 0,24,0:RETURN
  13. 130 *YN
  14. 140 WAIT 9:LINE(400,100)-(465,133),PSET,7,BF,0:SYMBOL(401,101),"ＹＮ",2,2,6:MOUSE 4,400,100,463,132
  15. 150 YN=INT((MOUSE(0)-400)/32):LINE(400+YN*32,100)-(431+YN*32,133),XOR,7,BF:LINE(400+YN*32,100)-(431+YN*32,133),XOR,7,BF
  16. 160 IF MOUSE(2,0)=0 THEN 150 ELSE RETURN
  17. 170 *色表示
  18. 180 LINE(0,460)-(640,480),PSET,0,BF:FOR A=0 TO 15:LINE(40+A*32,460)-(71+A*32,479),PSET,%A,BF:LINE(40+A*32,460)-(71+A*32,479),PSET,7,B:NEXT:RETURN
  19. 190 *MAIN
  20. 200 CX=MOUSE(0):CY=MOUSE(1):GET@A(C1X,C1Y)-(C1X+15,C1Y+15),PIC1:GET@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2:LINE(C2X,C2Y)-(C2X+31,C2Y+31),XOR,7,B:LINE(C1X,C1Y)-(C1X+15,C1Y+15),XOR,7,B:PUT@A(C1X,C1Y)-(C1X+15,C1Y+15),PIC1
  21. 210 PUT@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2
  22. 220 IF MOUSE(2,0)=-1 THEN C1X=CX:C1Y=CY:C2X=INT(CX/32)*32:C2Y=INT(CY/32)*32:GOTO 200
  23. 230 IF MOUSE(2,1)=0 THEN 200
  24. 240 GOSUB *PICIN
  25. 250 MOUSE 1,,,0:LINE(200,50)-(400,372),PSET,0,BF:LINE(0,460)-(639,479),PSET,7,BF,0:SYMBOL(10,462),"制作  元内康博(１５～１６歳) Ｖｅｒ　４.２４  ９１年９月　～９２年１１月０４日",1,1,7
  26. 260 FOR A=0 TO 18:LINE(200,50+A*17)-(400,67+A*17),PSET,7,B:SYMBOL(201,50+A*17),SE$(A),1,1,7:NEXT:MOUSE 4,200,50,400,371:MOUSE 1,,,1
  27. 270 CY=INT((MOUSE(1)-50)/17):LINE(200,50+CY*17)-(400,67+CY*17),XOR,7,BF:WAIT 5:LINE(200,50+CY*17)-(400,67+CY*17),XOR,7,BF
  28. 280 IF MOUSE(2,0)=-1 THEN 300
  29. 290 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:MOUSE 4,0,0,639,479:GOTO *MAIN ELSE 270
  30. 300 MOUSE 4,0,0,639,479:GOSUB *PICOUT:IF CY=0 THEN *画面消去
  31. 310 ON CY+1 GOTO *画面消去,*B16,*B32,*PA,*DISK,*DISK2,*CDC,*塗り潰し,*絵の複写,*STOP,*絵の拡大,*反転,*B64,*ｱﾆﾒ,*圧縮,*展開,*入替え,*線を描く,*速度
  32. 320 GOTO *MAIN
  33. 330 *STOP
  34. 340 LOCATE 0,0:PRINT "プログラムを終了していいですか｡":GOSUB *YN
  35. 350 GOSUB *PICOUT:CLS 4:IF YN=1 THEN *MAIN ELSE STOP
  36. 360 *画面消去
  37. 370 GOSUB *YN:MOUSE 4,0,0,639,479:GOSUB *PICOUT:IF YN=0 THEN CLS:GOSUB *PICIN:GOTO *MAIN ELSE *MAIN
  38. 380 *B16
  39. 390 MOUSE 1,,,0:GET@A(C1X,C1Y)-(C1X+15,C1Y+15),PIC2:LINE(42,42)-(313,313),PSET,0,BF:PUT@A(50,50)-(65,65),PIC2,PSET,16,16:LINE(310,310)-(346,346),PSET,0,BF:PUT@A(320,320)-(335,335),PIC2
  40. 400 FOR A=0 TO 15:LINE(50+A*16,50)-(50+A*16,305),PSET,%1:LINE(50,50+A*16)-(305,50+A*16),PSET,%1:A$=RIGHT$(STR$(A),1+INT(A/10)):SYMBOL(54+A*16,42),A$,.5!,.5!,6:SYMBOL(42,54+A*16),A$,.5!,.5!,6:NEXT:GOSUB *色表示:LINE(570,448)-(601,480),PSET,%CO,BF
  41. 410 LINE(570,448)-(601,479),XOR,7,B:SYMBOL(605,460),STR$(CO),1,1,6:MOUSE 1,,,1
  42. 420 CX=MOUSE(0):CY=MOUSE(1)
  43. 430 IF MOUSE(2,1)=-1 THEN GET@A(320,320)-(335,335),PIC2:GOSUB *PICOUT:PUT@A(C1X,C1Y)-(C1X+15,C1Y+15),PIC2:GOTO *MAIN
  44. 440 IF MOUSE(2,0)=0 THEN 420
  45. 450 IF CY>50 AND CX>50 AND CX<305 AND CY<305 THEN 470 
  46. 460 IF CX>40 AND CY>460 AND CX<551 THEN 490 ELSE 420
  47. 470 CX=INT((CX-50)/16):CY=INT((CY-50)/16)
  48. 480 LINE(CX*16+51,CY*16+51)-(CX*16+65,CY*16+65),PSET,%CO,BF:PSET(320+CX,CY+320),%CO:GOTO 420
  49. 490 CO=INT((CX-40)/32):LINE(570,448)-(601,479),PSET,%CO,BF:LINE(570,448)-(601,479),XOR,7,B:LINE(605,460)-(640,479),PSET,0,BF:SYMBOL(605,460),STR$(CO),1,1,6:GOTO 420
  50. 500 *CDC
  51. 510 LINE(300,200)-(400,250),PSET,0,BF:FOR A=0 TO 1:LINE(300,210+A*17)-(400,227+A*17),PSET,7,B:NEXT:SYMBOL(301,211),"ＣＤを聞く",1,1,6:SYMBOL(301,228),"ＣＤを止める",1,1,6:MOUSE 4,300,200,400,233
  52. 520 CY=INT((MOUSE(1)-200)/17):LINE(300,210+CY*17)-(400,227+CY*17),XOR,7,BF:LINE(300,210+CY*17)-(400,227+CY*17),XOR,7,BF
  53. 530 IF MOUSE(2,0)=0 THEN 520
  54. 540 IF CY=0 THEN CD PLAY ELSE CD STOP
  55. 550 MOUSE 4,0,0,639,479:GOSUB *PICOUT:GOTO *MAIN
  56. 560 *B32
  57. 570 MOUSE 1,,,0:GET@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2:LINE(C2X,C2Y)-(C2X+31,C2Y+31),PSET,7,B
  58. 580 PUT@A(100,50)-(131,81),PIC2,,12,12:LINE(499,199)-(559,249),PSET,7,BF:PUT@A(510,210)-(541,241),PIC2
  59. 590 FOR A=0 TO 31:LINE(100+A*12,50)-(100+A*12,432),PSET,%1:LINE(100,50+A*12)-(482,50+A*12),PSET,%1:NEXT:GOSUB *色表示:LINE(570,448)-(601,480),PSET,%CO,BF:LINE(570,448)-(601,479),XOR,7,B:SYMBOL(605,460),STR$(CO),1,1,6
  60. 600 FOR A=0 TO 2:LINE(196+A*96,50)-(196+A*96,432),PSET,7,,&H0707:LINE(100,146+A*96)-(482,146+A*96),PSET,7,,&H0707:NEXT:MOUSE 1,,,1
  61. 610 CX=MOUSE(0):CY=MOUSE(1)
  62. 620 IF MOUSE(2,1)=-1 THEN GET@A(510,210)-(541,241),PIC2:GOSUB *PICOUT:PUT@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2:GOTO *MAIN
  63. 630 IF MOUSE(2,0)=0 THEN 610
  64. 640 IF CX>40 AND CY>460 AND CX<551 THEN 670
  65. 650 IF CX>100 AND CY>50 AND CX<481 AND CY<431 THEN 660 ELSE 610
  66. 660 CX=INT((CX-100)/12):CY=INT((CY-50)/12):LINE(101+CX*12,51+CY*12)-(111+CX*12,61+CY*12),PSET,%CO,BF:PSET(510+CX,210+CY),%CO:GOTO 610
  67. 670 CO=INT((CX-40)/32):LINE(570,448)-(601,479),PSET,%CO,BF:LINE(570,448)-(601,479),XOR,7,B:LINE(605,460)-(640,479),PSET,0,BF:SYMBOL(605,460),STR$(CO),1,1,6:GOTO 610
  68. 680 *B64
  69. 690 C5X=C2X:C5Y=C2Y
  70. 700 IF C5X+64>640 THEN C5X=576
  71. 710 IF C5Y+64>480 THEN C5Y=416
  72. 720 MOUSE 1,,,0:GET@A(C5X,C5Y)-(C5X+63,C5Y+63),PIC3:PUT@A(0,0)-(63,63),PIC3,,7,7
  73. 730 GOSUB *色表示:FOR A=0 TO 64:LINE(A*7,0)-(A*7,448),PSET,%1:LINE(0,A*7)-(448,A*7),PSET,%1:NEXT:LINE(570,448)-(601,480),PSET,%CO,BF:LINE(570,448)-(601,479),XOR,7,B:SYMBOL(605,460),STR$(CO),1,1,6
  74. 740 FOR A=0 TO 5:LINE(480,A*32)-(639,A*32+32),PSET,%15,BF,%0:SYMBOL(520,A*32),KMID$("同色塗り潰し範囲塗り潰し 上へ移動  右へ移動  下へ移動  左へ移動",1+A*6,6),1,2,%15:NEXT
  75. 750 FOR A=1 TO 7:LINE(56*A,0)-(A*56,448),PSET,7,,&H0707:LINE(0,A*56)-(448,A*56),PSET,7,,&H0707:NEXT:LINE(499,199)-(564,264),PSET,7,B:PUT@A(500,200)-(563,263),PIC3
  76. 760 LINE(500,300)-(639,396),PSET,7,BF,0:FOR A=0 TO 2:SYMBOL(500,300+A*32),"↓",2,2,7:SYMBOL(608,300+A*32),"↑",2,2,7:NEXT
  77. 770 LINE(533,301)-(607,395),PSET,0,BF:FOR A=0 TO 2:SYMBOL(533,300+A*32),STR$(PL(A,CO)),2,2,7:NEXT:MOUSE 1,,,1
  78. 780 CX=MOUSE(0):CY=MOUSE(1)
  79. 790 IF CX>480 AND CY<192 THEN CC=INT(CY/32):LINE(480,CC*32)-(639,CC*32+32),XOR,7,BF:WAIT 5:LINE(480,CC*32)-(639,CC*32+32),XOR,7,BF
  80. 800 IF MOUSE(2,1)=-1 THEN GET@A(500,200)-(563,263),PIC3:GOSUB *PICOUT:PUT@A(C5X,C5Y)-(C5X+63,C5Y+63),PIC3:GOTO *MAIN
  81. 810 IF MOUSE(2,0)=0 THEN 780
  82. 820 IF CX<448 AND CY<448 THEN 860
  83. 830 IF CX>500 AND CY>300 AND CY<394 THEN 880
  84. 840 IF CX>480 AND CY<192 THEN 920
  85. 850 IF CX>40 AND CY>460 AND CX<551 THEN 870 ELSE 780
  86. 860 CX=INT(CX/7):CY=INT(CY/7):LINE(1+CX*7,1+CY*7)-(6+CX*7,6+CY*7),PSET,%CO,BF:PSET(500+CX,200+CY),%CO:GOTO 780
  87. 870 CO=INT((CX-40)/32):LINE(570,448)-(601,479),PSET,%CO,BF:LINE(570,448)-(601,479),XOR,7,B:LINE(605,460)-(640,479),PSET,0,BF:SYMBOL(605,460),STR$(CO),1,1,6:GOTO 770
  88. 880 CX=INT((CX-500)/70):CY=INT((CY-300)/32):IF CX=0 THEN CC=-1 ELSE CC=1
  89. 890 C2=PL(CY,CO):C2=INT(INT((C2+1)/16+CC)*16):IF C2>255 THEN C2=255
  90. 900 IF C2<0 THEN C2=0
  91. 910 PL(CY,CO)=C2:PALETTE CO,[PL(0,CO),PL(1,CO),PL(2,CO)]:GOTO 770
  92. 920 GET@A(500,200)-(563,263),PIC3:LINE(480,0)-(639,192),PSET,%15,BF,%0:IF CC=0 THEN 1030
  93. 930 IF CC=1 THEN 1080
  94. 940 IX=0:IY=0:IF CC=2 THEN IY=-1
  95. 950 IF CC=3 THEN IX=1
  96. 960 IF CC=4 THEN IY=1
  97. 970 IF CC=5 THEN IX=-1
  98. 980 GET@A(500,200)-(563,263),PIC3:GOSUB *PICOUT:PUT@A(C5X,C5Y)-(C5X+63,C5Y+63),PIC3:GOSUB *PICIN:C5X=C5X+IX*32:C5Y=C5Y+IY*32:IF C5X<0 THEN C5X=0
  99. 990 IF C5X+64>640 THEN C5X=576
  100. 1000 IF C5Y<0 THEN C5Y=0
  101. 1010 IF C5Y+64>480 THEN C5Y=416
  102. 1020 GOTO 720
  103. 1030 SYMBOL(520,0),"何処から",1,2,%15:SYMBOL(500,32),"塗り潰しますか｡",1,2,%15
  104. 1040 CX=MOUSE(0):CY=MOUSE(1)
  105. 1050 IF MOUSE(2,1)=-1 THEN 730
  106. 1060 IF MOUSE(2,0)=0 THEN 1040
  107. 1070 CX=INT(CX/7)+C5X:CY=INT(CY/7)+C5Y:GOSUB *PICOUT:PUT@A(C5X,C5Y)-(C5X+63,C5Y+63),PIC3:PAINT@(CX,CY),%CO:GOTO *B64
  108. 1080 SYMBOL(520,0),"何処から",1,2,%15:SYMBOL(500,32),"塗り潰しますか｡",1,2,%15
  109. 1090 CX=MOUSE(0):CY=MOUSE(1)
  110. 1100 IF MOUSE(2,1)=-1 THEN 730
  111. 1110 IF MOUSE(2,0)=0 THEN 1090
  112. 1120 LINE(480,0)-(639,192),PSET,%15,BF,%0:IF CC=0 THEN 1030
  113. 1130 SYMBOL(520,0),"何処まで",1,2,%15:SYMBOL(500,32),"塗り潰しますか｡",1,2,%15:CCX=INT(CX/7):CCY=INT(CY/7)
  114. 1140 CX=MOUSE(0):CY=MOUSE(1):LINE(CCX*7+3,CCY*7+3)-(INT(CX/7)*7+3,INT(CY/7)*7+3),XOR,7,B:LINE(CCX*7+3,CCY*7+3)-(INT(CX/7)*7+3,INT(CY/7)*7+3),XOR,7,B
  115. 1150 IF MOUSE(2,1)=-1 THEN 730
  116. 1160 IF MOUSE(2,0)=0 THEN 1140
  117. 1170 CX=INT(CX/7)+C5X:CY=INT(CY/7)+C5Y:GOSUB *PICOUT:PUT@A(C5X,C5Y)-(C5X+63,C5Y+63),PIC3:LINE(CCX+C5X,CCY+C5Y)-(CX,CY),PSET,%CO,BF:GOTO *B64
  118. 1180 *PA
  119. 1190 LINE(0,0)-(200,36),PSET,7,BF,0:MOUSE 1,,,0:FOR A=0 TO 15:LINE(A*36,145)-(A*36+40,430),PSET,%A,BF:LINE(A*36,100)-(A*36+35,135),PSET,%A,BF:LINE(A*36,100)-(A*36+35,135),PSET,7,B
  120. 1191 FOR B=0 TO 2:LINE(A*36+B*12,150)-(A*36+B*12+9,PL(B,A)+150),PSET,0,BF,7:NEXT:NEXT:MOUSE 1,,,1:MOUSE 4,0,150,568,406
  121. 1200 CX=INT(MOUSE(0)/12):CCP=INT((MOUSE(1)-150)/16)*16:CPC=INT(CX/3):COC=CX-CPC*3:LINE(CX*12,150)-(CX*12+10,PL(COC,CPC)+150),XOR,7,BF:LINE(CX*12,150)-(CX*12+10,PL(COC,CPC)+150),XOR,7,BF
  122. 1210 IF CCP>255 THEN CCP=255
  123. 1220 CLS 4:PRINT "変更時の値";CCP:PRINT "現在の値　";PL(COC,CPC)
  124. 1230 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:MOUSE 4,0,0,639,479:GOTO *MAIN
  125. 1240 IF MOUSE(2,0)=0 THEN 1200
  126. 1250 PL(COC,CPC)=CCP:PALETTE CPC,[PL(0,CPC),PL(1,CPC),PL(2,CPC)]
  127. 1260 LINE(CPC*36+COC*12,150)-(CPC*36+COC*12+9,406),PSET,%CPC,BF:LINE(CPC*36+COC*12,150)-(CPC*36+COC*12+9,150+PL(COC,CPC)),PSET,0,BF,7:GOTO 1200
  128. 1270 *DISK
  129. 1280 FOR A=0 TO 1:LINE(100,100+A*32)-(240,131+A*32),PSET,7,BF,0:SYMBOL(101,101+A*32),MID$("ＳＡＶＥＬＯＡＤ",A*8+1,8),2,2,7:NEXT
  130. 1290 MOUSE 4,100,100,240,163
  131. 1300 CY=INT((MOUSE(1)-100)/32):LINE(100,100+CY*32)-(240,131+CY*32),XOR,7,BF:LINE(100,100+CY*32)-(240,131+CY*32),XOR,7,BF
  132. 1310 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,639,479:GOSUB *PICOUT:GOTO *MAIN
  133. 1320 CONSOLE 0,24,2:IF MOUSE(2,0)=0 THEN 1300
  134. 1330 MOUSE 4,0,0,639,479:IF CY=1 THEN 1470
  135. 1340 CLS:PRINT "どのドライブにＳＡＶＥしますか？":A$=INPUT$(1):IF A$=CHR$(13) THEN GOSUB *PICOUT:GOTO *MAIN
  136. 1350 IF ASC(A$)<65 OR ASC(A$)>81 THEN 1340
  137. 1360 SHELL A$+":":CLS:ON ERROR GOTO *G1:FILES"*.*"
  138. 1370 ON ERROR GOTO *E1:IF MEM$<>"" THEN PRINT "前回入力したファイル名　";MEM$
  139. 1380 F$="":LINE INPUT "SAVEFILES or 命令？　";F$:IF LEFT$(F$,2)="CD" THEN SHELL F$:GOTO 1360
  140. 1390 IF RIGHT$(F$,1)=":" THEN A$=LEFT$(F$,1):GOTO 1360
  141. 1400 IF F$="" THEN GOSUB *PICOUT:GOTO *MAIN
  142. 1410 MEM$=F$:CLS:GOSUB *PICOUT
  143. 1420 CX=INT(MOUSE(0)/32)*32-1:CY=INT(MOUSE(1)/32)*32-1:LINE(0,0)-(CX,CY),XOR,7,B:WAIT 3:LINE(0,0)-(CX,CY),XOR,7,B
  144. 1430 IF MOUSE(2,0)=0 THEN 1420
  145. 1440 ECC=0:ON ERROR GOTO *E1:SAVE@ A$+":"+F$+".TIF",(0,0)-(CX,CY):ON ERROR GOTO 0:GOTO *MAIN
  146. 1450 *G1
  147. 1460 PRINT "ファイルが存在しません｡":RESUME 1370
  148. 1470 CLS:PRINT "どのドライブからＬＯＡＤしますか？":A$=INPUT$(1):IF A$=CHR$(13) THEN GOSUB *PICOUT:GOTO *MAIN
  149. 1480 IF ASC(A$)<65 OR ASC(A$)>81 THEN 1470
  150. 1490 SHELL A$+":":CLS:ON ERROR GOTO *G2:FILES"*.TIF"
  151. 1500 ON ERROR GOTO *E2:IF MEM$<>"" THEN PRINT "前回入力したファイル名　";MEM$
  152. 1510 F$="":LINE INPUT "LOADFILES or 命令？　";F$:IF LEFT$(F$,2)="CD" THEN SHELL F$:GOTO 1490
  153. 1520 IF RIGHT$(F$,1)=":" THEN A$=LEFT$(F$,1):GOTO 1490
  154. 1530 IF F$="" THEN GOSUB *PICOUT:GOTO *MAIN
  155. 1540 MEM$=F$:MOUSE 4,0,0,639,479:CLS
  156. 1550 CX=INT(MOUSE(0)/32)*32:CY=INT(MOUSE(1)/32)*32:LINE(CX,CY)-(639,479),PSET,7,B:GOSUB *PICOUT
  157. 1560 IF MOUSE(2,0)=0 THEN 1550
  158. 1570 ON ERROR GOTO *E2:LOAD@ "A:"+F$+".TIF",(CX,CY):ON ERROR GOTO 0:GOTO *MAIN
  159. 1580 *G2
  160. 1590 PRINT "ファイルが存在しません｡":RESUME 1500
  161. 1600 *E1
  162. 1610 IF ERR=55 THEN BEEP:RESUME 1360
  163. 1620 IF ERR=64 THEN 1660
  164. 1630 IF ERR=112 THEN IF ECC=1 THEN ECC=0:KILL "A:"+F$+".TIF":RESUME
  165. 1640 IF ERR=60 OR ERR=72 OR ERR=73 THEN CLS:SYMBOL(50,50),"ＳＡＶＥに失敗しました",1,1,7:BEEP:WAIT 300:GOSUB *PICOUT:RESUME *MAIN
  166. 1650  CLS:SYMBOL(50,50),"エラーが発生しました",1,1,7:SYMBOL(50,70),"行番号"+STR$(ERL)+"エラー番号"+STR$(ERR),1,1,7:BEEP:WAIT 300:GOSUB *PICOUT:ON ERROR GOTO 0:RESUME *MAIN
  167. 1660 CLS:ECC=1:LOAD@ "A:"+F$+".TIF":SYMBOL(0,460),"この絵を消していいですか",1,1,7:GOSUB *YN:GOSUB *PICOUT:IF YN=0 THEN KILL "A:"+F$+".TIF":RESUME ELSE RESUME *MAIN
  168. 1670 *E2
  169. 1680 IF ERR=63 THEN CLS:SYMBOL(50,50),"指定のファイルは存在していません",1,1,7:BEEP:WAIT 300:GOSUB *PICOUT:RESUME *MAIN ELSE 1650
  170. 1690 *E3
  171. 1700 IF ERR=64 THEN KILL "A:"+F$+".DAT":RESUME ELSE 1640
  172. 1710 *DISK2
  173. 1720 CLS:FOR A=0 TO 1:LINE(100,100+A*32)-(240,131+A*32),PSET,7,B:SYMBOL(101,101+A*32),MID$("ＳＡＶＥＬＯＡＤ",A*8+1,8),2,2,7:NEXT
  174. 1730 MOUSE 4,100,100,240,163
  175. 1740 CY=INT((MOUSE(1)-100)/32):LINE(100,100+CY*32)-(240,131+CY*32),XOR,7,BF:LINE(100,100+CY*32)-(240,131+CY*32),XOR,7,BF
  176. 1750 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:MOUSE 4,0,0,639,479:GOTO *MAIN
  177. 1760 IF MOUSE(2,0)=0 THEN 1740
  178. 1770 CLS:MOUSE 4,0,0,639,479:IF CY=0 THEN 1800
  179. 1780 FILES "A:*.DAT":INPUT "LOAD PALETTE FILES";F$:CLS 4
  180. 1790 ON ERROR GOTO *E2:OPEN "I",#1,"A:"+F$+".DAT":FOR A=0 TO 15:INPUT #1,PL(0,A),PL(1,A),PL(2,A):PALETTE A,[PL(0,A),PL(1,A),PL(2,A)]:NEXT:CLOSE #1:GOSUB *PICOUT:ON ERROR GOTO 0:GOTO *MAIN
  181. 1800 INPUT "SAVE PALETTE FILES";F$:CLS 4
  182. 1810 ON ERROR GOTO *E3:OPEN "O",#1,"A:"+F$+".DAT":FOR A=0 TO 15:WRITE #1,PL(0,A),PL(1,A),PL(2,A):NEXT:CLOSE #1:GOSUB *PICOUT:ON ERROR GOTO 0:GOTO *MAIN
  183. 1820 *塗り潰し
  184. 1830 LINE(100,50)-(250,129),PSET,0,BF:FOR A=0 TO 4:LINE(100,50+A*16)-(250,65+A*16),PSET,7,B
  185. 1840 SYMBOL(100,50+A*16),MID$("　範囲塗り潰し　　１６＊１６四角の枠１６＊１６キャラ　３２＊３２四角の枠同色塗り潰し",A*18+1,18),1,1,7:NEXT:MOUSE 4,100,50,250,129
  186. 1850 CY=INT((MOUSE(1)-50)/16):LINE(100,50+CY*16)-(250,65+CY*16),XOR,7,BF:LINE(100,50+CY*16)-(250,65+CY*16),XOR,7,BF
  187. 1860 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,639,479:GOSUB *PICOUT:GOTO *MAIN
  188. 1870 IF MOUSE(2,0)=0 THEN 1850
  189. 1880 CC=-1:MOUSE 4,0,0,639,479:GOSUB *PICOUT:IF CY=0 THEN 2000
  190. 1890 IF CY=4 THEN WAIT 70:GOTO 1940
  191. 1900 IF CY=1 THEN LINE(C1X,C1Y)-(C1X+15,C1Y+15),PSET,%CO,BF
  192. 1910 IF CY=2 THEN CX=INT(C1X/16)*16:CCY=INT(C1Y/16)*16:LINE(CX,CCY)-(CX+15,CCY+15),PSET,%CO,BF
  193. 1920 IF CY=3 THEN LINE(C2X,C2Y)-(C2X+31,C2Y+31),PSET,%CO,BF
  194. 1930 GOTO *MAIN
  195. 1940 CX=MOUSE(0):CY=MOUSE(1):C1=1-INT(CX/320)
  196. 1950 IF C1<>CC THEN CC=C1:PUT@A(0,0)-(639,479),PIC全
  197. 1960 GET@A(CX-2,CY-2)-(CX+2,CY+2),PIC1:C1=320-INT(CX/320)*320:PUT@A(100+C1,200)-(104+C1,204),PIC1,,12,12:LINE(124+C1,224)-(135+C1,235),XOR,7,B:LINE(110+C1,80)-(200+C1,96),PSET,0,BF:SYMBOL(110+C1,80),STR$(CX)+STR$(CY),1,1,7
  198. 1970 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  199. 1980 IF MOUSE(2,0)=0 THEN 1940
  200. 1990 PUT@A(0,0)-(639,479),PIC全:PAINT @ (CX,CY),%CO:GOTO *MAIN
  201. 2000 CX=MOUSE(0):CY=MOUSE(1):C1=1-INT(CX/320)
  202. 2010 IF C1<>CC THEN CC=C1:PUT@A(0,0)-(639,479),PIC全
  203. 2020 GET@A(CX-2,CY-2)-(CX+2,CY+2),PIC1:C1=320-INT(CX/320)*320:PUT@A(100+C1,200)-(104+C1,204),PIC1,,12,12:LINE(124+C1,224)-(135+C1,235),XOR,7,B:LINE(110+C1,80)-(200+C1,96),PSET,0,BF:SYMBOL(110+C1,80),STR$(CX)+STR$(CY),1,1,7
  204. 2030 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  205. 2040 IF MOUSE(2,0)=0 THEN 2000
  206. 2050 C3X=CX:C3Y=CY:PUT@A(0,0)-(639,479),PIC全
  207. 2060 CX=MOUSE(0):CY=MOUSE(1):C1=1-INT(CX/320)
  208. 2070 IF C1<>CC THEN CC=C1:PUT@A(0,0)-(639,479),PIC全
  209. 2080 GET@A(CX-2,CY-2)-(CX+2,CY+2),PIC1:C1=320-INT(CX/320)*320:PUT@A(100+C1,200)-(104+C1,204),PIC1,,12,12:LINE(124+C1,224)-(135+C1,235),XOR,7,B:LINE(110+C1,80)-(200+C1,96),PSET,0,BF:SYMBOL(110+C1,80),STR$(CX)+STR$(CY),1,1,7:LINE(C3X,C3Y)-(CX,CY),XOR,7,B
  210. 2090 LINE(C3X,C3Y)-(CX,CY),XOR,7,B:IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  211. 2100 IF MOUSE(2,0)=0 THEN 2060
  212. 2110 PUT@A(0,0)-(639,479),PIC全:LINE(C3X,C3Y)-(CX,CY),PSET,%CO,BF:GOTO *MAIN
  213. 2120 *絵の複写
  214. 2130 LINE(100,50)-(250,97),PSET,0,BF:FOR A=0 TO 2:LINE(100,50+A*16)-(250,67+A*16),PSET,7,B:SYMBOL(100,50+A*16),MID$("１６＊１６キャラ３２＊３２キャラ範囲複写",1+A*16,16),1,1,7:NEXT:MOUSE 4,100,50,250,97
  215. 2140 CY=INT((MOUSE(1)-50)/16)
  216. 2150 LINE(100,50+CY*16)-(250,67+CY*16),XOR,7,BF:LINE(100,50+CY*16)-(250,67+CY*16),XOR,7,BF
  217. 2160 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,639,479:GOSUB *PICOUT:GOTO *MAIN
  218. 2170 IF MOUSE(2,0)=0 THEN 2140
  219. 2180 WAIT 50:MOUSE 4,0,0,639,479:PUT@A(0,0)-(639,479),PIC全:IF CY=0 THEN 2200
  220. 2190 IF CY=1 THEN 2250 ELSE 2300
  221. 2200 C4X=INT(C1X/16)*16:C4Y=INT(C1Y/16)*16:GET@A(C4X,C4Y)-(C4X+15,C4Y+15),PIC2
  222. 2210 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16:PUT@A(CX,CY)-(CX+15,CY+15),PIC2:PUT@A(0,0)-(639,479),PIC全
  223. 2220 IF MOUSE(2,1)=-1 THEN *MAIN
  224. 2230 IF MOUSE(2,0)=0 THEN 2210
  225. 2240 PUT@A(CX,CY)-(CX+15,CY+15),PIC2:GOSUB *PICIN:GOTO 2210
  226. 2250 GET@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2
  227. 2260 CX=INT(MOUSE(0)/32)*32:CY=INT(MOUSE(1)/32)*32:PUT@A(CX,CY)-(CX+31,CY+31),PIC2:PUT@A(0,0)-(639,479),PIC全
  228. 2270 IF MOUSE(2,1)=-1 THEN *MAIN
  229. 2280 IF MOUSE(2,0)=0 THEN 2260
  230. 2290 PUT@A(CX,CY)-(CX+31,CY+31),PIC2:GOSUB *PICIN:GOTO 2260
  231. 2300 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16:GET@A(CX-2,CY-2)-(CX+2,CY+2),PIC1:C1=320-INT(CX/320)*320:PUT@A(100+C1,200)-(104+C1,204),PIC1,,12,12:LINE(124+C1,224)-(135+C1,235),XOR,7,B:SYMBOL(110+C1,80),STR$(CX)+STR$(CY),1,1,7
  232. 2310 PUT@A(0,0)-(639,479),PIC全
  233. 2320 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  234. 2330 IF MOUSE(2,0)=0 THEN 2300
  235. 2340 C3X=CX:C3Y=CY:BEEP:WAIT 20
  236. 2350 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16:GET@A(CX-2,CY-2)-(CX+2,CY+2),PIC1:C1=320-INT(CX/320)*320:PUT@A(100+C1,200)-(104+C1,204),PIC1,,12,12:LINE(124+C1,224)-(135+C1,235),XOR,7,B:SYMBOL(110+C1,80),STR$(CX)+STR$(CY),1,1,7
  237. 2360 LINE(C3X,C3Y)-(CX,CY),PSET,7,B
  238. 2370 PUT@A(0,0)-(639,479),PIC全:IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  239. 2380 IF MOUSE(2,0)=0 THEN 2350
  240. 2390 GET@A(C3X,C3Y)-(CX,CY),PIC絵:C3X=C3X-CX:C3Y=C3Y-CY:BEEP:WAIT 20
  241. 2400 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16:PUT@A(CX,CY)-(CX+C3X,CY+C3Y),PIC絵:PUT@A(0,0)-(639,479),PIC全
  242. 2410 IF MOUSE(2,0)=0 THEN 2400
  243. 2420 PUT@A(CX,CY)-(CX+C3X,CY+C3Y),PIC絵:GOTO *MAIN
  244. 2430 *絵の拡大
  245. 2440 CLS 4:COLOR 12:PRINT "何処から拡大しますか":COLOR 7
  246. 2450 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16
  247. 2460 IF MOUSE(2,1)=-1 THEN CLS 4:GOTO *MAIN
  248. 2470 IF MOUSE(2,0)=0 THEN 2450
  249. 2480 IF MOUSE(2,0)=-1 THEN 2480
  250. 2490 CCX=CX:CCY=CY:CLS 4:COLOR 13:PRINT "何処まで拡大しますか":COLOR 7
  251. 2500 CX=INT(MOUSE(0)/16)*16-1:CY=INT(MOUSE(1)/16)*16-1
  252. 2510 LINE(CCX,CCY)-(CX,CY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B
  253. 2520 IF MOUSE(2,0)=0 THEN 2500
  254. 2530 GET@A(CCX,CCY)-(CX,CY),PIC絵:CCX=CCX-CX:CCY=CCY-CY
  255. 2540 CLS 4:PRINT "何倍に拡大しますか？":KA!=1:LINE(200,240)-(264,272),PSET,7,BF,0:SYMBOL(201,241),"減増",2,2,7
  256. 2550 LINE(200,240)-(264,272),PSET,7,BF,0:SYMBOL(201,241),"減増",2,2,7:LINE(200,200)-(240,220),PSET,%15,BF,%0:SYMBOL(201,201),STR$(KA!),1,1,7
  257. 2560 CX=MOUSE(0):CY=MOUSE(1)
  258. 2570 IF MOUSE(2,1)=-1 THEN 2640
  259. 2580 IF MOUSE(2,0)=0 THEN 2560
  260. 2590 IF CX>200 AND CY>240 AND CY<271 AND CX<263 THEN 2600 ELSE 2560
  261. 2600 CX=INT((CX-200)/32)
  262. 2610 IF CX=0 THEN CX=-1
  263. 2620 KA!=KA!+CX/10:IF KA!<.1! THEN KA!=.1! 
  264. 2630 PUT@A(0,0)-(-CCX,-CCY),PIC絵,,KA!,KA!:GOTO 2550
  265. 2640 CLS 4:COLOR 12:PRINT "何処に複写しますか":COLOR 7:MOUSE 1,,,0
  266. 2650 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16
  267. 2660 PUT@A(CX,CY)-(CX-CCX,CY-CCY),PIC絵,,KA!,KA!
  268. 2670 PUT@A(0,0)-(639,479),PIC全
  269. 2680 IF MOUSE(2,1)=-1 THEN *MAIN
  270. 2690 IF MOUSE(2,0)=0 THEN 2650
  271. 2700 PUT@A(CX,CY)-(CX-CCX,CY-CCY),PIC絵,,KA!,KA!:CLS 4:MOUSE 1,,,1:GOTO *MAIN
  272. 2710 *反転
  273. 2720 LINE(200,100)-(266,134),PSET,7,BF,0:SYMBOL(201,101),"左右反転",1,1,7:SYMBOL(201,117),"上下反転",1,1,7:MOUSE 4,201,101,265,131
  274. 2730 CY=INT((MOUSE(1)-100)/16)
  275. 2740 LINE(201,101+CY*16)-(265,116+CY*16),XOR,7,BF:LINE(201,101+CY*16)-(265,116+CY*16),XOR,7,BF
  276. 2750 IF MOUSE(2,1)=-1 THEN MOUSE 4,0,0,639,479:GOSUB *PICOUT:GOTO *MAIN
  277. 2760 IF MOUSE(2,0)=0 THEN 2730
  278. 2770 MOUSE 4,0,0,639,479:CLS 4:CC=CY:PRINT "何処から反転しますか｡":WAIT 30
  279. 2780 CX=MOUSE(0):CY=MOUSE(1)
  280. 2790 IF MOUSE(2,0)=0 THEN 2780
  281. 2800 CCX=INT(CX/32)*32:CCY=INT(CY/32)*32:CLS 4:PRINT "何処までを反転しますか｡":WAIT 30
  282. 2810 CX=INT(MOUSE(0)/32)*32-1:CY=INT(MOUSE(1)/32)*32-1:LINE(CCX,CCY)-(CX,CY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B
  283. 2820 IF MOUSE(2,0)=0 THEN 2810
  284. 2830 IF CX<=CCX OR CY<=CCY THEN CLS 4:GOTO 2720
  285. 2840 CLS 4:GOSUB *PICOUT:C4X=CX-CCX:C4Y=CY-CCY:GET@A(CCX,CCY)-(CX,CY),PIC絵:IF CC=0 THEN 2870
  286. 2850 CC=INT((C4X+1)/4):C2=CC*C4Y:FOR A=0 TO C4Y:PUT@A(CCX,CCY+A)-(CCX+C4X,CCY+A),PIC絵,,,,,C2-A*CC
  287. 2860 NEXT:GOTO *MAIN
  288. 2870 AD!=512*CCY+INT(CCX/2):MOUSE 1,,,0
  289. 2880 C1=0:FOR A=0 TO C4Y:FOR B=INT(C4X/2) TO 0 STEP -1
  290. 2890 C=PEEK([&H1C]AD!+A*512+B)
  291. 2900 C2=INT(C/16):C3=C-C2*16:PIC絵(C1*2)=C2:PIC絵(C1*2+1)=C3:C1=C1+1
  292. 2910 NEXT:NEXT
  293. 2920 C1=0:FOR A=0 TO C4Y:FOR B=0 TO C4X
  294. 2930 PSET(CCX+B,CCY+A),%PIC絵(C1):C1=C1+1
  295. 2940 NEXT:NEXT:MOUSE 1,,,1:GOTO *MAIN
  296. 2950 *ｱﾆﾒ
  297. 2960 WAIT 40
  298. 2970 CY=INT(MOUSE(1)/64):LINE(0,CY*64)-(639,CY*64+63),XOR,7,B:LINE(0,CY*64)-(639,CY*64+63),XOR,7,B
  299. 2980 IF MOUSE(2,1)=-1 THEN *MAIN
  300. 2990 IF MOUSE(2,0)=0 THEN 2970
  301. 3000 FOR A=0 TO 1:FOR B=0 TO 19:GET@A(B*32,A*32+CY*64)-(B*32+31,A*32+CY*64+31),PIC絵,B*256+A*5120:NEXT:NEXT
  302. 3010 LINE(0,300)-(639,350),PSET,0,BF:A=0
  303. 3020 FOR B=0 TO 19:PUT@A(B*32,320)-(B*32+31,351),PIC絵,,,,,256*B+A*5120:NEXT
  304. 3030 A=1-A
  305. 3040 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN ELSE 3020
  306. 3050 *圧縮
  307. 3060 CX=INT(MOUSE(0)/16)*16:CY=INT(MOUSE(1)/16)*16
  308. 3070 LINE(0,0)-(CX-1,CY-1),XOR,7,B:LINE(0,0)-(CX-1,CY-1),XOR,7,B
  309. 3080 IF MOUSE(2,0)=-1 THEN 3100
  310. 3090 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN ELSE 3060
  311. 3100 MOUSE 1,,,0:CX=CX-1:CY=CY-1:X=0:Y=0:CC=-1:C2=0:AD=2:PIC絵(0)=CX:PIC絵(1)=CY
  312. 3110 C2=1:X=2:CC=PEEK([&H1C]0):WHILE Y<=CY:C=PEEK([&H1C]X/2+Y*512)
  313. 3120 IF CC=C THEN C2=C2+1:GOTO 3160
  314. 3130 PIC絵(AD)=CC:AD=AD+1
  315. 3140 IF C2<>1 THEN PIC絵(AD)=C2+256:AD=AD+1
  316. 3150 CC=C:C2=1
  317. 3160 X=X+2:IF X>CX THEN X=0:Y=Y+1
  318. 3170 WEND
  319. 3180 PIC絵(AD)=CC:AD=AD+1:IF C2=1 THEN 3200
  320. 3190 PIC絵(AD)=C2+256
  321. 3200 AD=AD-1:DIM MPD(AD)
  322. 3210 FOR A=0 TO AD:MPD(A)=PIC絵(A):NEXT
  323. 3220 ON ERROR GOTO *E11
  324. 3230 INPUT "SAVEするFILE名";F$:F$="A:"+F$
  325. 3240 SAVE@ F$+".DAT",MPD
  326. 3250 MOUSE 1,,,1:GOTO *MAIN
  327. 3260 *E11
  328. 3270 IF ERR=64 THEN KILL F$+".DAT":RESUME 3240
  329. 3280 ON ERROR GOTO 0:RESUME
  330. 3290 *E12
  331. 3300 IF ERR=63 THEN 3320
  332. 3310 ON ERROR GOTO 0:RESUME
  333. 3320 BEEP:GOSUB *PICOUT:CLS 4:GOTO *MAIN
  334. 3330 *展開
  335. 3340 ON ERROR GOTO *E12:CLS:F$="":FILES "A:*.DAT":INPUT"展開するファイル";F$:IF F$="" THEN CLS 4:GOSUB *PICOUT:GOTO *MAIN
  336. 3350 F$="A:"+F$:MOUSE 1,,,0:LOAD@ F$+".DAT",PIC絵:CLS 4:COLOR 12:PRINT "しばらくお待ち下さい"
  337. 3360 X=0:Y=0:AD=2:CX=PIC絵(0):CY=PIC絵(1):LINE(0,0)-(CX,CY),PSET,0,BF:CX=INT(CX/2)
  338. 3370 WHILE Y<=CY:CC=PIC絵(AD):AD=AD+1
  339. 3380 C2=PIC絵(AD):IF C2<256 THEN C2=1 ELSE C2=C2-256:AD=AD+1
  340. 3390 FOR A=1 TO C2:POKE [&H1C]X+Y*512,CC:X=X+1:IF X>CX THEN X=0:Y=Y+1
  341. 3400 NEXT
  342. 3410 WEND
  343. 3420 COLOR 7:CLS 4:MOUSE 1,,,1:GOTO *MAIN
  344. 3430 *入替え
  345. 3440 GET@A(C2X,C2Y)-(C2X+31,C2Y+31),PIC2:CLS:PUT@A(0,0)-(31,31),PIC2,PSET,4,4
  346. 3450 LINE(50,50)-(500,80),PSET,%15,BF,%1:SYMBOL(51,51),"何色を入れ換えますか｡",1,1,7:GOSUB 3520:C1=CC
  347. 3460 LINE(50,50)-(500,80),PSET,%15,BF,%1:SYMBOL(51,51),"何色に入れ換えますか｡",1,1,7:GOSUB 3520
  348. 3470 GOSUB *PICOUT
  349. 3480 MOUSE 1,,,0:FOR A=0 TO 31:FOR B=0 TO 31
  350. 3490 GET@A(C2X+B,C2Y+A)-(C2X+B,C2Y+A),PIC2
  351. 3500 IF PIC2(0)=C1 THEN PSET(C2X+B,C2Y+A),%CC
  352. 3510 NEXT:NEXT:MOUSE 1,,,1:GOTO *MAIN
  353. 3520 LINE(299,199)-(364,264),PSET,%15,BF,%0
  354. 3530 FOR A=0 TO 3:FOR B=0 TO 3:LINE(300+B*16,200+A*16)-(315+B*16,215+A*16),PSET,%(A*4+B),BF:NEXT:NEXT
  355. 3540 MOUSE 4,300,200,363,263
  356. 3550 CX=MOUSE(0):CY=MOUSE(1)
  357. 3560 IF MOUSE(2,0)=0 THEN 3550
  358. 3570 CX=INT((CX-300)/16):CY=INT((CY-200)/16):CC=CY*4+CX
  359. 3580 MOUSE 4,0,0,640,480:RETURN
  360. 3590 *線を描く
  361. 3600 LINE(200,100)-(400,164),PSET,0,BF
  362. 3610 FOR A=0 TO 2:LINE(200,100+A*16)-(400,116+A*16),PSET,%15,B:SYMBOL(250,100+A*16),KMID$("細い線で描く繋ぎ線で描く 太線で描く",1+A*6,6),1,1,%15:NEXT:MOUSE 4,200,100,400,147
  363. 3620 CY=INT((MOUSE(1)-100)/16):LINE(200,100+CY*16)-(400,115+CY*16),XOR,7,BF:WAIT 4:LINE(200,100+CY*16)-(400,115+CY*16),XOR,7,BF
  364. 3630 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  365. 3640 IF MOUSE(2,0)=0 THEN 3620
  366. 3650 GOSUB *PICOUT:MOUSE 4,0,0,639,479:WAIT 40:IF CY=0 THEN 3700
  367. 3660 IF CY=1 THEN 3740
  368. 3670 IF CY=2 THEN 3690
  369. 3680 GOTO 3610
  370. 3690 DEF PEN 0,4
  371. 3700 CX=MOUSE(0):CY=MOUSE(1)
  372. 3710 IF MOUSE(2,1)=-1 THEN DEF PEN 0,1:GOTO *MAIN
  373. 3720 IF MOUSE(2,0)=0 THEN 3700
  374. 3730 PSET(CX,CY),%CO:GOTO 3700
  375. 3740 CC=0:C2=0
  376. 3750 CX=MOUSE(0):CY=MOUSE(1)
  377. 3760 IF MOUSE(2,1)=-1 THEN *MAIN
  378. 3770 IF MOUSE(2,0)=-1 THEN 3810
  379. 3780 IF CC=1 THEN C2=C2-1 ELSE 3750
  380. 3790 IF C2=0 THEN CC=0
  381. 3800 GOTO 3750
  382. 3810 IF CC=0 THEN CC=1:PSET(CX,CY),%CO:CCX=CX:CCY=CY:GOTO 3750
  383. 3820 C2=9:LINE(CX,CY)-(CCX,CCY),PSET,%CO:CCX=CX:CCY=CY:GOTO 3750
  384. 3830 *速度
  385. 3840 LINE(200,100)-(400,170),PSET,%15,BF,0:SYMBOL(200,105),"移動速度を決めてください",1,1,%15:SYMBOL(220,130),"↓",2,2,%15:SYMBOL(310,130),"↑",2,2,%15
  386. 3850 LINE(255,121)-(309,169),PSET,0,BF:SYMBOL(255,130),STR$(速度),2,2,%14
  387. 3860 CX=INT((MOUSE(0)-220)/70):CY=INT((MOUSE(1)-130)/32)
  388. 3870 IF MOUSE(2,1)=-1 THEN GOSUB *PICOUT:GOTO *MAIN
  389. 3880 IF MOUSE(2,0)=0 THEN 3860
  390. 3890 IF CY<>0 OR CX<0 OR CX>2 THEN 3860
  391. 3900 IF CX=0 THEN 速度=速度-1:IF 速度<2 THEN 速度=2
  392. 3910 IF CX=1 THEN 速度=速度+1:IF 速度>30 THEN 速度=30
  393. 3920 MOUSE 3,0,速度:MOUSE 3,1,速度:GOTO 3850
  394.